home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops ƒ / zStruct < prev    next >
Text File  |  1998-12-29  |  2KB  |  82 lines
  1. (*
  2. Most of the Struct classes are in pStruct.  Here we just have a couple of 
  3. classes that we couldn't put in pStruct, since they need reloc!
  4. *)
  5.  
  6.  
  7. \ X-ARRAY can execute its elements.
  8.  
  9. :class    X-ARRAY  super{ array }
  10.  
  11. :m TO:  ( index -- )    ^elem: super  reloc!  ;m
  12.  
  13. :m EXEC:  ( index -- )
  14. \    inline{ ^elem @abs execute}  ;m
  15.     inline{ ^elem  (ex_ra) }  ;m
  16.  
  17. :m FILL:        \ ( xt -- )
  18.     limit NIF  drop  EXIT  THEN        \ Out if no elements
  19.     idxbase  tuck  reloc!    @  fill: super  ;m
  20.  
  21. :m PUT:            \ ( xt0 ... xt(N-1) N -- )
  22.     limit  0EXIT                \ Out if no elements
  23.     false -> relocChk?            \ May get used in instantiating exported objs
  24.     limit ?#xts
  25.     idxbase  dup  limit 1-  4*  +
  26.     DO  i reloc!  -4 +LOOP
  27.     true -> relocChk?  ;m
  28.  
  29. :m ACTIONS:        \ A synonym for put:.  A more appropriate name to use in
  30.                 \ sub-classes such as dialogs.
  31.     put: self  ;m
  32.  
  33. private
  34.  
  35. :m PrintNxts:    \ ( n -- )
  36.     0 ?do  i ^elem: self  @abs  cr .id  loop  ;m
  37.  
  38. public
  39.  
  40. :m PRINT:        limit  printNxts: self  ;m
  41.  
  42. :m CLASSINIT:    ['] null  fill: self  ;m
  43.  
  44. ;class
  45.  
  46.  
  47. \ X-COL is a collection of execution tokens.
  48.  
  49. :class    X-COL    super{  (col)  x-array  }
  50.  
  51. :m  REMOVEXT:    \ ( xt -- )
  52.     false -> relocChk?  pad reloc!  true -> relocChk?
  53.     pad @  indexof: self  0EXIT
  54.     remove: self  ;m
  55.  
  56. :m  PRINT:
  57.     get: size  printNXts: self  ;m
  58.  
  59. ;class
  60.  
  61.  
  62. : CHKKEY
  63.     cr     type# 189            \ "paused - <space> to continue..."
  64.     cr                        \ 01Feb94 DBH  Add cr.  Better for TW.
  65.     (key)  cr  0 -> out  bl =  nif  cr decimal abort  then  ;
  66.  
  67.  
  68. : ?P
  69.     sleepticks  0 -> sleepticks
  70.     ?terminal
  71.     swap -> sleepticks
  72.     NIF  pause  EXIT  THEN        \ No key hit - just do default PAUSE
  73.     (key) drop  chkKey  ;
  74.  
  75. : P
  76.     sleepticks  0 -> sleepticks
  77.     ?terminal  drop
  78.     -> sleepticks  ;
  79.  
  80. ' p        -> pause            \ This will be improved when Events is loaded
  81. ' ?p    -> ?pause
  82.